Covid19 Daily with Google forecast

都道府県データ

prefs <- "https://gist.githubusercontent.com/k-metrics/9f3fc18e042850ff24ad9676ac34764b/raw/9262c36b0740edd575e9f0292dad61c9cce269be/pref_utf8.csv" %>%
# prefs <- "https://gist.githubusercontent.com/k-metrics/9f3fc18e042850ff24ad9676ac34764b/raw/b4c9a333fb4b54e11c8ae993b186bf3185467393/pref_utf8.csv" %>% 
  readr::read_csv() %>% 
  dplyr::mutate(japan_prefecture_code = paste0("JP-", `コード`)) %>% 
  dplyr::select(japan_prefecture_code, prefecture_name = pref, pref = `都道府県`,
                region = `八地方区分`,pops = `推計人口`) %>% 
  dplyr::mutate(japan_prefecture_code = forcats::fct_inorder(japan_prefecture_code),
                pref = forcats::fct_inorder(pref),
                region = forcats::fct_inorder(region),
                pops = as.integer(pops))
prefs

Covid19Japanデータ

df <- "https://raw.githubusercontent.com/reustle/covid19japan-data/master/docs/patient_data/latest.json" %>% 
  jsonlite::fromJSON() %>% 
  dplyr::select(patientId, date = dateAnnounced, gender,
                pref = detectedPrefecture, patientStatus, knownCluster,
                confirmedPatient,
                ageBracket,
                deceasedDate, deceasedReportedDate) %>% 
  dplyr::filter(confirmedPatient == TRUE) %>% 
  dplyr::mutate(date = lubridate::as_date(date),
                gender = forcats::as_factor(gender),
                pref = stringr::str_to_lower(pref),
                patientStatus = forcats::as_factor(patientStatus),
                cluster = dplyr::if_else(!is.na(knownCluster), TRUE, FALSE),
                ageBracket = forcats::as_factor(ageBracket),
                deceasedDate = lubridate::as_date(deceasedDate),
                deceasedReportedDate = lubridate::as_date(deceasedReportedDate)) %>% 
  dplyr::left_join(prefs, by = c("pref" = "prefecture_name")) %>% 
  dplyr::select(-pref) %>% 
  dplyr::rename(pref = pref.y)
df

Google予測データ

fn <- "https://storage.googleapis.com/covid-external/forecast_JAPAN_PREFECTURE_28.csv" %>% 
  readr::read_csv() %>% 
  dplyr::select(pref = prefecture_name_kanji, date = target_prediction_date,
                fcum = cumulative_confirmed) %>% 
  dplyr::arrange(date) %>% 
  dplyr::group_by(pref) %>% 
  tidyr::nest() %>% 
  dplyr::mutate(fn = purrr::map(data, ~ lagdiff(.$fcum))) %>% 
  tidyr::unnest() %>% 
  tidyr::drop_na() %>%
  dplyr::select(-fcum)
fn

Google予測データ

forecast <- "https://storage.googleapis.com/covid-external/forecast_JAPAN_PREFECTURE_28.csv" %>% 
  readr::read_csv() %>% 
  dplyr::mutate(prefecture_name = stringr::str_to_lower(prefecture_name)) %>% 
  dplyr::left_join(prefs, by = c("prefecture_name")) %>% 
  dplyr::select(code = japan_prefecture_code.x, pref, region, pops,
                date = target_prediction_date,
                fcum = cumulative_confirmed,
                fcum_q0025 = cumulative_confirmed_q0025,
                fcum_q0975 = cumulative_confirmed_q0975) %>% 
  dplyr::left_join(fn, by = c("pref", "date")) %>% 
  dplyr::mutate(n = NA_integer_, diff = NA_integer_, cum = NA_integer_,
                ma7 = NA_real_, ma28 = NA_real_) %>% 
  dplyr::select(code, pref, region, pops, date, n, diff, cum, ma7, ma28,
                fn, fcum, fcum_q0025, fcum_q0975) %>% 
  dplyr::arrange(code, date) %>% 
  dplyr::mutate(pref = forcats::fct_inorder(pref)) %>% 
  tidyr::drop_na(fn)

forecast

描画用データ

x <- df %>% 
  dplyr::group_by(date, pref) %>% 
  dplyr::summarise(n = n()) %>% 
  dplyr::ungroup() %>% 
  tidyr::pivot_wider(names_from = pref, values_from = n, values_fill = 0L) %>% 
  tidyr::complete(date = seq.Date(from = min(date), to = max(date), by = "day")) %>% 
  tidyr::pivot_longer(cols = -date, names_to = "pref", values_to = "n") %>% 
  tidyr::replace_na(replace = list(n = 0L)) %>% 
  dplyr::group_by(pref) %>% 
  tidyr::nest() %>% 
  dplyr::mutate(diff = purrr::map(data, ~ lagdiff(.$n)),
                cum = purrr::map(data, ~ cumsum(.$n)),
                ma7 = purrr::map(data, ~ ma7(.$n)),
                ma28 = purrr::map(data, ~ ma28(.$n))) %>% 
  tidyr::unnest() %>% 
  dplyr::left_join(prefs, ., by = c("pref")) %>% 
  dplyr::mutate(pref = forcats::fct_inorder(pref)) %>% 
  dplyr::arrange(date) %>% 
  dplyr::rename(code = japan_prefecture_code) %>%
  dplyr::select(-prefecture_name) %>% 
  dplyr::mutate(fn = NA_real_, fcum = NA_real_,
                fcum_q0025 = NA_real_, fcum_q0975 = NA_real_)
x

可視化

sec_scale <- 100
ncol <- 3

forecast %>% 
  dplyr::filter(date > max(x$date)) %>%
  dplyr::bind_rows(x) %>% 
  dplyr::rename(key = pref) %>% 
  ggplot2::ggplot(ggplot2::aes(x = date)) + 
    ggplot2::geom_bar(ggplot2::aes(y = n, fill = key), stat = "identity",
                      alpha = 0.5, width = 1.0) + 
    ggplot2::geom_bar(ggplot2::aes(y = fn, fill = key), stat = "identity",
                      alpha = 0.25, width = 1.0) + 
    ggplot2::geom_line(ggplot2::aes(y = cum / sec_scale, colour = key),
                                    linetype = "solid") +
    ggplot2::geom_line(ggplot2::aes(y = fcum / sec_scale, colour = key),
                                    linetype = "solid", alpha = 0.5, size = 0.35) +
    ggplot2::facet_wrap(~ key, ncol = ncol, scales = "free_y") +
    ggplot2::theme(legend.position = 'none')